home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 1
/
Cream of the Crop 1.iso
/
PROGRAM
/
BPAS9.ARJ
/
3_3.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-09-07
|
10KB
|
289 lines
{---------------------------------------------------------------------
PROGRAM: 3_3
This program uses the same template feature to build looping procedures
quickly, filling in the NULL.PROC procedure template as needed, moving the
new procedure to it alphabetical place in the procedures, and placing
the procedure name in the MAIN PROGGRAM so that it is called in its
turn.
See Tom Swan Chapter 4. Divide and Conquer.
Author: Mike Benedict
Date Started: 9/01/91
Latest Revision: 9/01/91
Version: Turbo Pascal 6.0
-------------------------------------------------------------------}
PROGRAM Lesson3_2;
USES { USES is a reserved word that }
Crt; { tells the compiler to use one }
{ of the standard libraries or }
{ units listed in the Pascal }
{ Programmer's Guide. }
VAR
Choice : Char; { Used in CASE Statements }
UserQuits : Boolean; { Used to Quit Menu & Program }
{ Note that all variables declared here
are GLOBAL and recognizable to the
program anywhere. }
{------------------------------------} { Anything between brackets }
{ PROCEDURES } { is ignored at compile time }
{------------------------------------} { and allows clear comments }
{ within source code. }
{-----------------------------}
{ INIT.PROC }
{-----------------------------}
PROCEDURE Init;
BEGIN
TextBackground(Blue); { Procedures and functions that }
TextColor(White); { are pre-defined by Borland's }
ClrScr; { Reference manual. They are }
END; { called the Run-Time Library. }
{-----------------------------}
{ METRIC.PROC }
{-----------------------------}
PROCEDURE METRIC;
{ See Tom Swan p.62 }
{ Swan makes this a procedure. }
VAR
Value : Real;
Selection : Integer;
{---------Inches to Centimeters-----------------------} { Nested Procedures and Functions }
PROCEDURE InchesToCentimeters; { Swan makes this a procedure, and we
leave it a procedure. }
CONST
CentPerInch = 2.54; { Note that all constants and
variables are LOCAL in this
procedure. }
BEGIN
WriteLn( Value:1:2, ' inches = ',
Value * CentPerInch:1:2, ' centimeters' );
ReadLn { Swan doesn't use this }
END; { InchesToCentimeters }
{---------Centimeters to Inches-----------------------}
PROCEDURE CentimetersToInches;
CONST
InchPerCent = 0.397;
BEGIN
WriteLn ( Value:1:2, ' centimeters = ',
Value * InchPerCent:1:2, ' inches' );
ReadLn { Swan doesn't use this }
END; { CentimetersToInches }
{---------Feet to Meters------------------------------}
PROCEDURE FeetToMeters;
CONST
MetersPerFt = 0.9144;
BEGIN
WriteLn ( Value:1:2, ' Feet = ',
Value * MetersPerFt:1:2, ' Meters' );
ReadLn { Swan doesn't use this }
END; { FeetToMeters }
{---------Meters to Feet------------------------------}
PROCEDURE MetersToFeet;
CONST
FtPerMeter = 1.0936;
BEGIN
WriteLn ( Value:1:2, ' Meters = ',
Value * FtPerMeter:1:2, ' Feet' );
ReadLn { Swan doesn't use this }
END; { MetersToFeet }
{---------Miles to Kilometers-------------------------}
PROCEDURE MilesToKilometers;
CONST
KmPerMile = 1.6093;
BEGIN
WriteLn ( Value:1:2, ' Miles = ',
Value * KmPerMile:1:2, ' Kilometers' );
ReadLn { Swan doesn't use this }
END; { MilesToKilometers }
{---------Kilometers to Miles-------------------------}
PROCEDURE KilometersToMiles;
CONST
MilesPerKm = 0.62139;
BEGIN
WriteLn ( Value:1:2, ' Kilometers = ',
Value * MilesPerKm:1:2, ' Miles' );
ReadLn { Swan doesn't use this }
END; { KilometersToMiles }
{-----------------------------------------------------}
BEGIN
ClrScr;
WriteLn;
WriteLn;
Write ( 'METRICS' );
WriteLn;
WriteLn;
Write ( 'Value to Convert? ' );
ReadLn (Value);
WriteLn ( '1 - Inches to centimeters' );
WriteLn ( '2 - Centimeters to inches' );
WriteLn ( '3 - FeetToMeters ' );
WriteLn ( '4 - MetersToFeet ' );
WriteLn ( '5 - Miles to Kilometers ' );
WriteLn ( '6 - Kilometers to miles ' );
WriteLn;
Write ( 'Selection? ' ); ReadLn ( Selection );
WriteLn;
CASE Selection OF
1 : InchesToCentimeters;
2 : CentimetersToInches;
3 : FeetToMeters;
4 : MetersToFeet;
5 : MilesToKilometers;
6 : KilometersToMiles;
ELSE WriteLn ( 'Selection Error' )
END { CASE }
END;
{-----------------------------}
{ RANGECHK2.PROC }
{-----------------------------}
PROCEDURE RangeChk2;
VAR
Age : 0..100;
BEGIN
ClrScr;
WriteLn;
WriteLn;
Write ( 'How old are you? ' );
{$R-} { Turn Range Checking Off }
ReadLn ( Age );
IF (Age) > 100 THEN
WriteLn ('Age is too high. See value below and then re-enter. ')
ELSE
IF (Age) < 0 THEN
WriteLn ('Age is too low. See value below and then re-enter. ')
ELSE
{$R+} { Turn Range Checking On }
WriteLn;
WriteLn;
WriteLn ( 'You are ', Age, ' years old.' );
ReadLn;
END;
{-----------------------------}
{ .PROC }
{-----------------------------}
PROCEDURE Null;
BEGIN
END;
{------------------------------------}
{ MAIN PROGRAM }
{------------------------------------}
BEGIN
Init; { Procedure Call }
UserQuits := False; { Boolean Variable set to false }
REPEAT { Note that REPEAT UNTIL contains all the
WriteLn statements of the Menu, then the
ReadLn statement to capture the input,
before the CASE END block. }
ClrScr;
WriteLn;
WriteLn ( ' Welcome to Beginners Pascal');
WriteLn;
WriteLn ( ' MENU');
WriteLn;
WriteLn ( ' A. Metric Conversion ' );
WriteLn ( ' B. [Unused Menu Choice]' );
WriteLn ( ' C. Range Check with Program Error Message ' );
WriteLn ( ' Q. User Quits Menu' );
WriteLn;
WriteLn;
Write ( 'Select a menu choice: ' );
ReadLn ( Choice );
{ The CASE ___ OF statement uses the variable,
in this case "Choice" to capture the input,
then executes that procedure/function. }
{ Notice that after a choice, the loop returns
back to the Menu. }
CASE Choice OF
'a', 'A' : Metric; { Choice A calls Procedure METRIC }
'b', 'B' : Null; { Choice B calls Procedure RangeChk }
'c', 'C' : RangeChk2; { Etc. }
'd', 'D' : Null;
'e', 'E' : Null; { Choice calls Null.Proc until assigned }
'q', 'Q' : UserQuits := True; { Choice Q changes boolean value to False
and exits Repeat Until Loop and goes to
next line of Main Program code. That is,
in this program it stops repeating the
menu and drops the user to a cursor. When
you press <ENTER>, it exits the program.
Change the program to exit immediately.}
END
UNTIL UserQuits;
ReadLn;
END. { ReadLn stops the program for user }
{ input. This is a common }
{ way to get the program to stop and }
{ show you the screen without pres- }
{ sing ALT-F5. }